unit uDZRangeList;

interface

uses
  uDZBinaryTree;

type
  TDzIntegerRange = record
    min: Integer;
    max: Integer;
  end;
  PDzIntegerRange = ^TDzIntegerRange;

  TDzIntRangeRBTNode = class(TDzRBTreeNode)
  protected
    function CompareValue(Tree: TDzBinaryTree;
      Other: Pointer): Integer; override;
    function Compare(Tree: TDzBinaryTree;
      Other: TDzBinaryTreeNode): Integer; override;
  public
    Min: Integer;
    Max: Integer;  
  end;

  TDzIntRangeRBTree = class(TDzRBTree)
  private
    fNumberCount: Integer;
    procedure AddNode(Min, Max: Integer);
    procedure DeleteNode(Node: TDzIntRangeRBTNode);
  public
    procedure Clear; override;
    procedure Add(Key: Integer); overload;
    procedure Add(Min, Max: Integer); overload;
    procedure Delete(Key: Integer); overload;
    procedure Delete(Min, Max: Integer); overload;
    function Exists(Key: Integer): Boolean; overload;
    function Exists(Min, Max: Integer): Boolean; overload;
    property NumberCount: Integer read fNumberCount;
  end;
  
  TDzIntRangeList = class
  private
    fList: array of TDzIntegerRange;
    fCount: Integer;
    function GetItems(index: Integer): Integer;
    procedure SetItems(index: Integer; const Value: Integer);
  protected
    function CalcInsertPos(item: Integer): Integer;
    procedure Delete(index: Integer);
    procedure Combine(min: Integer; max: Integer);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Add(item: Integer);
    procedure AddRange(min, max: Integer);
    function Exists(v: Integer; p: PPointer): Boolean;
    procedure Remove(item: Integer);
    procedure RemoveRange(min, max: Integer);
    procedure Clear;
    property Count: Integer read fCount;
    property Items[index: Integer]: Integer read GetItems write SetItems;
  end;

implementation

{ TDzIntRangeList }

procedure TDzIntRangeList.Add(item: Integer);
begin
  AddRange(item, item);    
end;

procedure TDzIntRangeList.AddRange(min, max: Integer);
var
  index, newMin, newMax: Integer;
  ext: Boolean;
begin
  if (Length(fList) = 0) then
  begin
    SetLength(fList, 1);
    fList[0].min := min;
    fList[0].max := max;
    fCount := max - min + 1;
    Exit;
  end;
  ext := False;
  newMin := 0;
  newMax := max;
  index := CalcInsertPos(min);
  if ((index > Low(fList)) and ((fList[index - 1].max >= min))) then
    min := fList[index - 1].max + 1;
  if ((index <= High(fList)) and (fList[index].min <= max)) then
  begin
    max := fList[index].min - 1;
    if (fList[index].max < newMax) then
    begin
      newMin := fList[index].max + 1;
      ext := True;
    end;
  end;
  if (min <= max) then
  begin
    Inc(fCount, max - min + 1);
    if ((index > Low(fList)) and (min = fList[index - 1].max + 1)) then
    begin
      fList[index - 1].max := max;
      if ((index <= High(fList)) and (max = fList[index].min - 1)) then
      begin
        fList[index - 1].max := fList[index].max;
        Delete(index);
      end;
    end
    else if ((index <= High(fList)) and (max = fList[index].min - 1)) then
    begin
      fList[index].min := min;
      if ((index > Low(fList)) and (min = fList[index - 1].max + 1)) then
      begin
        fList[index].min := fList[index - 1].min;
        Delete(index - 1);
      end;
    end
    else begin
      SetLength(fList, Length(fList) + 1);
      if (index <= High(fList)) then
        Move(fList[index], fList[index + 1], SizeOf(fList[0]) * (High(fList) - index));
      fList[index].min := min;
      fList[index].max := max;
    end;
  end;
  if (ext) then Combine(newMin, newMax);
end;

function TDzIntRangeList.CalcInsertPos(item: Integer): Integer;
var
  L, R, M: Integer;
begin
  L := Low(fList);
  R := High(fList);
  while (L <= R) do
  begin
    M := (L + R) div 2;
    if (fList[M].min < item) then
    begin
      if (M < High(fList)) then
      begin
        if (fList[M + 1].min >= item) then
        begin
          Result := M + 1;
          Exit;
        end
        else begin
          L := M + 1;
          Continue;
        end;
      end
      else begin
        Result := M + 1;
        Exit;
      end;
    end
    else if (fList[M].min = item) then
    begin
      Result := M;
      Exit;
    end
    else begin
      if (M > Low(fList)) then
      begin
        if (fList[M - 1].min <= item) then
        begin
          Result := M;
          Exit;
        end
        else begin
          R := M - 1;
          Continue;
        end;
      end
      else begin
        Result := M;
        Exit;
      end;
    end;
  end;
  Result := High(fList) + 1;
end;

procedure TDzIntRangeList.Clear;
begin
  SetLength(fList, 0);
  fCount := 0;
end;

procedure TDzIntRangeList.Combine(min, max: Integer);
var
  index, lastIndex: Integer;
  num: Integer;
begin
  if (Length(fList) = 0) then AddRange(min, max);
  index := CalcInsertPos(min);
  if (index = High(fList) + 1) then
  begin
    if (fList[High(fList)].Max < min - 1) then
    begin
      SetLength(fList, Length(fList) + 1);
      fList[High(fList)].min := min;
      fList[High(fList)].max := max;
      Inc(fCount, max - min + 1);
    end
    else begin
      if (fList[High(fList)].max < max) then
      begin
        Inc(fCount, max - fList[High(fList)].max);
        fList[High(fList)].max := max;
      end;
    end;      
    Exit;
  end;
  
  if (index > Low(fList)) and (fList[index - 1].max = min - 1) then
  begin
    min := fList[index - 1].min;
    Dec(index);
    num := 0;
  end
  else num := fList[index].min - min;
  lastIndex := index + 1;
  while (lastIndex <= High(fList)) and (fList[lastIndex].min <= max + 1) do
  begin
    Inc(num, fList[lastIndex].min - fList[lastIndex - 1].max - 1);
    Inc(lastIndex);
  end;

  if (fList[lastIndex - 1].max > max) then
    max := fList[lastIndex - 1].max
  else
    Inc(num, max - fList[lastIndex - 1].max);
  fList[index].min := min;
  fList[index].max := max;
  if (lastIndex - index - 1 > 0) then
  begin
    if (lastIndex <= High(fList)) then
      Move(fList[lastIndex], fList[index + 1],
        SizeOf(fList[0]) * High(fList) - lastIndex + 1);
    SetLength(fList, Length(fList) + index + 1 - lastIndex);
  end;
  Inc(fCount, num);
end;

constructor TDzIntRangeList.Create;
begin
  SetLength(fList, 0);
end;

procedure TDzIntRangeList.Delete(index: Integer);
begin
  if (index < High(fList)) then
    Move(fList[index + 1], fList[index],
      SizeOf(fList[0]) * (High(fList) - index));
  SetLength(fList, Length(fList) - 1);
end;

destructor TDzIntRangeList.Destroy;
begin
  SetLength(fList, 0);
  inherited;
end;

function TDzIntRangeList.GetItems(index: Integer): Integer;
var
  i, num: Integer;
begin
  num := -1;
  i := Low(fList);
  while ((i <= High(fList)) and (num < index)) do
  begin
    Inc(num);
    if (num + fList[i].max - fList[i].min < index) then
    begin
      Inc(num, fList[i].max - fList[i].min);
      Inc(i);
    end
    else Break;
  end;
  if (i <= High(fList)) then
    Result := fList[i].min + index - num
  else Result := 0;
end;

procedure TDzIntRangeList.Remove(item: Integer);
begin
  RemoveRange(item, item);
end;

procedure TDzIntRangeList.RemoveRange(min, max: Integer);
var
  index: Integer;
  pmin, pmax, nmin, nmax: Integer;
begin
  if (fCount = 0) then Exit;
  AddRange(min, max);
  Exists(min, @index);
  pmin := fList[index].min;
  pmax := min - 1;
  nmin := max + 1;
  nmax := fList[index].max;
  if (pmin <= pmax) then
  begin
    fList[index].max := pmax;
    if (nmin <= nmax) then
    begin
      SetLength(fList, Length(fList) + 1);
      if (index < High(fList) - 1) then
        Move(fList[index + 1], fList[index + 2], SizeOf(fList[0]) *
          High(fList) - index);
      fList[index + 1].min := nmin;
      fList[index + 1].max := nmax; 
    end;
  end
  else if (nmin <= nmax) then
  begin
    fList[index].min := nmin;
    fList[index].max := nmax;
  end
  else begin
    Delete(index);
  end;
  Dec(fCount, max - min + 1);
end;

procedure TDzIntRangeList.SetItems(index: Integer; const Value: Integer);
begin

end;

function TDzIntRangeList.Exists(v: Integer; p: PPointer): Boolean;
var
  index: Integer;
begin
  Result := False;
  if (fCount = 0) then Exit;
  index := CalcInsertPos(v);
  if ((index <= High(fList)) and (fList[index].min = v)) then
  begin
    if (p <> nil) then
      PInteger(p)^ := index;
    Result := True;
    Exit;
  end;
  if ((index > Low(fList)) and (fList[index - 1].max >= v)) then
  begin
    if (p <> nil) then
      PInteger(p)^ := index - 1;
    Result := True;
    Exit;
  end;
end;

{ TDzIntRangeRBTNode }

function TDzIntRangeRBTNode.Compare(Tree: TDzBinaryTree;
  Other: TDzBinaryTreeNode): Integer;
begin
  with TDzIntRangeRBTNode(Other) do
  begin
    if Self.Min > Max then Result := 1
    else if Self.Max < Min then Result := -1
    else Result := 0; 
  end;
end;

function TDzIntRangeRBTNode.CompareValue(Tree: TDzBinaryTree;
  Other: Pointer): Integer;
begin
  with PDzIntegerRange(Other)^ do
  begin
    if Self.Min > Max then Result := 1
    else if Self.Max < Min then Result := -1
    else Result := 0; 
  end;
end;

{ TDzIntRangeRBTree }

procedure TDzIntRangeRBTree.Add(Key: Integer);
begin
  Add(Key, Key);
end;

procedure TDzIntRangeRBTree.Add(Min, Max: Integer);
var
  Node: TDzIntRangeRBTNode;
  Range: TDzIntegerRange;
begin
  Range.min := Min;
  Range.max := Max;
  while True do
  begin
    Node := TDzIntRangeRBTNode(Find(@Range));
    if Node = nil then Break;
    if (Node.Min <= Min) and (Node.Max >= Max) then Exit;
    if Node.Max < Range.Max then 
    begin
      if Range.min > Node.Min then Range.min := Node.Min;
      DeleteNode(Node);
    end;
  end;
  AddNode(Range.min, Range.max);
end;

procedure TDzIntRangeRBTree.AddNode(Min, Max: Integer);
var
  Node: TDzIntRangeRBTNode;
begin
  Node := TDzIntRangeRBTNode.Create;
  Node.Min := Min;
  Node.Max := Max;
  Insert(Node);
  Inc(fNumberCount, Max - Min + 1);
end;

procedure TDzIntRangeRBTree.Clear;
begin
  inherited;
  fNumberCount := 0;
end;

function TDzIntRangeRBTree.Exists(Min, Max: Integer): Boolean;
var
  Range: TDzIntegerRange;  
begin
  Range.min := Min;
  Range.max := Max;
  Result := Find(@Range) <> nil;
end;

procedure TDzIntRangeRBTree.Delete(Key: Integer);
begin
  Delete(Key, Key);
end;

procedure TDzIntRangeRBTree.Delete(Min, Max: Integer);
var
  Node: TDzIntRangeRBTNode;
  Range: TDzIntegerRange;
  a, b, c, d: Integer;
begin
  while True do
  begin
    Range.min := Min;
    Range.max := Max;
    Node := TDzIntRangeRBTNode(Find(@Range));
    if Node = nil then Exit;
    if Node.Min < Min then
    begin
      a := Node.Min;
      b := Min - 1;
    end
    else begin
      a := 1;
      b := 0;
    end;

    if Node.Max > Max then
    begin
      c := Max + 1;
      d := Node.Max;
    end
    else begin
      c := 1;
      d := 0;
    end;
    
    Min := Node.Max + 1;
     
    DeleteNode(Node);
    
    if a <= b then AddNode(a, b);

    if c <= d then AddNode(c, d)
    else Exit;
  end;
end;

procedure TDzIntRangeRBTree.DeleteNode(Node: TDzIntRangeRBTNode);
begin
  Dec(fNumberCount, Node.Max - Node.Min + 1);
  inherited Delete(Node);  
end;

function TDzIntRangeRBTree.Exists(Key: Integer): Boolean;
begin
  Result := Exists(Key, Key);
end;

end.
